home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / G0A.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  21KB  |  683 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. /* g0a -  initializations (corresponds to needed parts of adasem 0a.c */
  11.  
  12. #define GEN
  13.  
  14. #include "hdr.h"
  15. #include "vars.h"
  16. #include "gvars.h"
  17. #include "gutilp.h"
  18. #include "dbxp.h"
  19. #include "setp.h"
  20. #include "arithp.h"
  21. #include "miscp.h"
  22. #include "smiscp.h"
  23. #include "g0ap.h"
  24.  
  25. static Node val_node1(int);
  26. static Node val_nodea1(int);
  27. static Node val_node2(double);
  28. static Node val_node3(Rational);
  29. static void init_node_save(Node);
  30. static void sym_inits(Symbol, Symbol, Tuple, Symbol);
  31. static void sym_initg(Symbol, int, int, int);
  32.  
  33. static int    init_node_count = 0;
  34. extern int ADA_MIN_INTEGER, ADA_MAX_INTEGER;
  35. extern int list_unit_0; /* set by gmain.c to list unit 0 structure */
  36.  
  37. void init_sem()                                            /*; init_sem */
  38. {
  39.     Tuple    constr_new, tup, boolean_constraint, constr_character, lmap;
  40.     Symbol    s;
  41.     int    i;
  42.     char   *p, *p1;
  43.     Symbol sym;
  44.     char    name[20];
  45.     static char *char_names[] = {
  46.         "NUL 0",
  47.         "SOH 1",
  48.         "STX 2",
  49.         "ETX 3",
  50.         "EOT 4",
  51.         "ENQ 5",
  52.         "ACK 6",
  53.         "BEL 7",
  54.         "BS 8",
  55.         "HT 9",
  56.         "LF 10",
  57.         "VT 11",
  58.         "FF 12",
  59.         "CR 13",
  60.         "SO 14",
  61.         "SI 15",
  62.         "DLE 16",
  63.         "DC1 17",
  64.         "DC2 18",
  65.         "DC3 19",
  66.         "DC4 20",
  67.         "NAK 21",
  68.         "SYN 22",
  69.         "ETB 23",
  70.         "CAN 24",
  71.         "EM 25",
  72.         "SUB 26",
  73.         "ESC 27",
  74.         "FS 28",
  75.         "GS 29",
  76.         "RS 30",
  77.         "US 31",
  78.         "EXCLAM 33",
  79.         "QUOTATION 34",
  80.         "SHARP 35",
  81.         "DOLLAR 36",
  82.         "PERCENT 37",
  83.         "AMPERSAND 38",
  84.         "COLON 58",
  85.         "SEMICOLON 59",
  86.         "QUERY 63",
  87.         "AT_SIGN 64",
  88.         "L_BRACKET 91",
  89.         "BACK_SLASH 92",
  90.         "R_BRACKET 93",
  91.         "CIRCUMFLEX 94",
  92.         "UNDERLINE 95",
  93.         "GRAVE 96",
  94.         "LC_A 97",
  95.         "LC_B 98",
  96.         "LC_C 99",
  97.         "LC_D 100",
  98.         "LC_E 101",
  99.         "LC_F 102",
  100.         "LC_G 103",
  101.         "LC_H 104",
  102.         "LC_I 105",
  103.         "LC_J 106",
  104.         "LC_K 107",
  105.         "LC_L 108",
  106.         "LC_M 109",
  107.         "LC_N 110",
  108.         "LC_O 111",
  109.         "LC_P 112",
  110.         "LC_Q 113",
  111.         "LC_R 114",
  112.         "LC_S 115",
  113.         "LC_T 116",
  114.         "LC_U 117",
  115.         "LC_V 118",
  116.         "LC_W 119",
  117.         "LC_X 120",
  118.         "LC_Y 121",
  119.         "LC_Z 122",
  120.         "L_BRACE 123",
  121.         "BAR 124",
  122.         "R_BRACE 125",
  123.         "TILDE 126",
  124.         "DEL 127",
  125.         " "
  126.     };
  127.     current_instances = tup_new(0);
  128.     lib_stub = tup_new(0);
  129.  
  130.     seq_node = tup_new(400);
  131.     seq_node_n = 0;
  132.  
  133.     seq_symbol = tup_new(100);
  134.     seq_symbol_n = 0;
  135.  
  136.     unit_nodes = tup_new(0);
  137. #ifdef TBSL
  138.     unit_nodes_n = 0;
  139. #endif
  140.  
  141.     stub_info = tup_new(0);
  142.     unit_number_now = 0;
  143.  
  144.     init_nodes = tup_new(30);
  145.     init_symbols = tup_new(0);
  146.  
  147.     interfaced_procedures = tup_new(0);
  148.  
  149.     OPT_NODE = node_new(as_opt);
  150.     N_LIST(OPT_NODE) = tup_new(0);
  151.     init_node_save(OPT_NODE);
  152.  
  153. #ifdef IBM_PC
  154.     /* avoid copy of literal for PC */
  155. #define setname(sym, str) ORIG_NAME(sym) = strjoin(str, "")
  156. #else
  157. #define setname(sym, str) ORIG_NAME(sym) = str
  158. #endif
  159.  
  160.     OPT_NAME = sym_new(na_obj);
  161.     setname(OPT_NAME, "opt_name");
  162.  
  163. #ifdef IBM_PC
  164. #define sym_op_enter(sym, name) sym = sym_new(na_op); \
  165.  ORIG_NAME(sym) = strjoin(name, "");
  166. #else
  167. #define sym_op_enter(sym, name) sym = sym_new(na_op); ORIG_NAME(sym) = name;
  168. #endif
  169.  
  170.     symbol_integer = sym_new(na_type);
  171.     /* note that val_node1 sets N_TYPE field to symbol_integer, so must
  172.      * define symbol_integer before calling val_node1
  173.      */
  174.     constr_new = constraint_new(CONSTRAINT_RANGE);
  175.     numeric_constraint_low(constr_new) = (char *) val_node1(ADA_MIN_INTEGER);
  176.     numeric_constraint_high(constr_new) = (char *)val_node1(ADA_MAX_INTEGER);
  177.     sym_inits(symbol_integer, symbol_integer, constr_new, symbol_integer);
  178.     sym_initg(symbol_integer, TK_WORD, 1, 3);
  179.     setname(symbol_integer, "INTEGER");
  180.  
  181.     constr_new = constraint_new(CONSTRAINT_RANGE);
  182.     numeric_constraint_low(constr_new) = (char *) val_node1(-32768);
  183.     numeric_constraint_high(constr_new) = (char *) val_node1(32767);
  184.     symbol_short_integer_base = sym_new(na_type);
  185.     sym_inits(symbol_short_integer_base, symbol_integer,
  186.       constr_new, symbol_short_integer);
  187.     sym_initg(symbol_short_integer_base, TK_WORD, 1, 77);
  188.     setname(symbol_short_integer_base, "SHORT_INTEGER\'base");
  189.  
  190.     symbol_short_integer = sym_new(na_type);
  191.     sym_inits(symbol_short_integer, symbol_short_integer_base,
  192.       SIGNATURE(symbol_short_integer_base), symbol_short_integer);
  193.     sym_initg(symbol_short_integer, TK_WORD, 1, 77);
  194.     setname(symbol_short_integer, "SHORT_INTEGER");
  195.     ALIAS(symbol_short_integer_base) = symbol_short_integer;
  196.  
  197.     symbol_universal_integer = sym_new(na_type);
  198.     sym_inits(symbol_universal_integer , symbol_integer, 
  199.       SIGNATURE(symbol_integer), symbol_integer);
  200.     sym_initg(symbol_universal_integer, TK_WORD, 1, 3);
  201.     setname(symbol_universal_integer, "universal_integer");
  202.  
  203.     constr_new = constraint_new(CONSTRAINT_DIGITS);
  204.     numeric_constraint_low(constr_new) = (char *) val_node2(ADA_MIN_REAL);
  205.     numeric_constraint_high(constr_new) = (char *) val_node2(ADA_MAX_REAL);
  206.     numeric_constraint_digits(constr_new) = (char *) val_node1(ADA_REAL_DIGITS);
  207.     symbol_float = sym_new(na_type);
  208.     sym_inits(symbol_float, symbol_float, constr_new, symbol_float);
  209.     /* TBSL: there should be TK_REAL for floating point */
  210.     sym_initg(symbol_float, TK_LONG, 1, 73);
  211.     setname(symbol_float, "FLOAT");
  212.  
  213.     symbol_universal_real = sym_new(na_type);
  214.     sym_inits(symbol_universal_real, symbol_float, 
  215.       SIGNATURE(symbol_float), symbol_universal_real);
  216.     sym_initg(symbol_universal_real, TK_LONG, 1, 73);
  217.     setname(symbol_universal_real, "universal_real");
  218.  
  219.     constr_new = constraint_new(CONSTRAINT_DELTA);
  220.     numeric_constraint_low(constr_new) = (char *) val_node3(rat_fri(int_fri(-1),
  221.       int_fri(0)));
  222.     numeric_constraint_high(constr_new) = (char *) val_node3(rat_fri(int_fri(1),
  223.       int_fri(0)));
  224.     numeric_constraint_delta(constr_new) =
  225.       (char *) val_node3(rat_fri(int_fri(0), int_fri(1)));
  226.     numeric_constraint_small(constr_new) = (char *) OPT_NODE;
  227.     symbol_dfixed = sym_new(na_type);
  228.     sym_inits(symbol_dfixed , symbol_dfixed, constr_new, symbol_dfixed);
  229.     sym_initg(symbol_dfixed, TK_LONG, 1, 67);
  230.     setname(symbol_dfixed, "$FIXED");
  231.  
  232.     constr_new = constraint_new(CONSTRAINT_RANGE);
  233.     numeric_constraint_low(constr_new) = (char *) val_node1(0);
  234.     numeric_constraint_high(constr_new) = (char *) val_node1(ADA_MAX_INTEGER);
  235.     symbol_natural = sym_new(na_subtype);
  236.     sym_inits(symbol_natural , symbol_integer, constr_new, symbol_integer);
  237.     sym_initg(symbol_natural, TK_WORD, 1, 57);
  238.     setname(symbol_natural, "NATURAL");
  239.  
  240.     constr_new = constraint_new(CONSTRAINT_RANGE);
  241.     numeric_constraint_low(constr_new) = (char *) val_node1(1);
  242.     numeric_constraint_high(constr_new) = (char *) val_node1(ADA_MAX_INTEGER);
  243.     symbol_positive = sym_new(na_subtype);
  244.     sym_inits(symbol_positive , symbol_integer,
  245.       constr_new, symbol_integer);
  246.     sym_initg(symbol_positive, TK_WORD, 1, 22);
  247.     setname(symbol_positive, "POSITIVE");
  248.  
  249.     constr_new = constraint_new(CONSTRAINT_DELTA);
  250.     numeric_constraint_low(constr_new) = (char *)
  251.       val_node3(rat_fri(int_frs("-86400000"), int_fri(1000)));
  252.     numeric_constraint_high(constr_new) =  (char *)
  253.       val_node3(rat_fri(int_frs("86400000"), int_fri(1000)));
  254.     numeric_constraint_delta(constr_new) = 
  255.       (char *) val_node3(rat_fri(int_fri(1), int_fri(1000)));
  256.     numeric_constraint_small(constr_new) = (char *)val_node3(rat_fri(int_fri(1),
  257.       int_fri(1000)));
  258.     symbol_duration = sym_new(na_type);
  259.     sym_inits(symbol_duration , symbol_duration, constr_new, symbol_dfixed);
  260.     sym_initg(symbol_duration, TK_LONG, 1, 61);
  261.     setname(symbol_duration, "DURATION");
  262.  
  263.     constr_character = constraint_new(CONSTRAINT_RANGE);
  264.     numeric_constraint_low(constr_character) = (char *) val_node1(0);
  265.     numeric_constraint_high(constr_character) = (char *) val_node1(127);
  266.     symbol_character = sym_new(na_enum);
  267.     sym_inits(symbol_character , symbol_character, constr_character,
  268.       symbol_character);
  269.     sym_initg(symbol_character, TK_WORD, 1, 43);
  270.     setname(symbol_character, "CHARACTER");
  271.  
  272.     constr_new = constraint_new(CONSTRAINT_RANGE);
  273.     numeric_constraint_low(constr_new) = (char *)val_node1(0);
  274.     numeric_constraint_high(constr_new) = (char *) val_node1(1);
  275.     /* save constraint - needed to initialize symbol_constrained below*/
  276.     boolean_constraint = constr_new;
  277.     symbol_boolean = sym_new(na_enum);
  278.     sym_inits(symbol_boolean,  symbol_boolean, constr_new, symbol_boolean);
  279.     sym_initg(symbol_boolean, TK_WORD, 1, 7)